home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / PROTOCOL.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  28KB  |  970 lines
  1. UNIT Protocol;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Y/XModem, Sea/TeLink & Modem7 send/receive    Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos;
  16.  
  17. CONST
  18.   FinalName : PathStr='';
  19.  
  20. TYPE
  21.   ProtocolType = (YModem, XModem, SeaLink, TeLink, Modem7, _f, _b);
  22.  
  23. FUNCTION ReceiveFile(CONST FPath, FName: PathStr; Protocol: ProtocolType) : Integer;
  24. FUNCTION SendFile(CONST FName, Alias : PathStr; Protocol: ProtocolType) : Integer;
  25.  
  26. IMPLEMENTATION
  27.  
  28. USES OpCrt, OpString, OpDate, ApTimer,
  29.      Globals, Com, Modem, PoPTypes, Crc, Util, StrUtil, Mailutil,
  30.      FileUtil, TransVid, LogFile;
  31.  
  32.  
  33. CONST
  34.   SendACKLess    : Boolean = False;
  35.   NoOverdrive    : Boolean = True;
  36.   OverWrite      : Boolean = False;
  37.   SmallWindow    : Boolean = True;
  38.  
  39. TYPE
  40.   HeaderType = RECORD
  41.     FSize,
  42.     FTime          : LongInt;
  43.     FName          : String[16];
  44.     Moi            : String[14];
  45.     NoACKs         : Byte;
  46.   END;
  47.  
  48.   {-=-=-=-=-=-=-}
  49.  
  50. CONST
  51.   NetMail        : Boolean=False;
  52.  
  53. VAR
  54.   FileSecs       : LongInt;
  55.   _FPath         : PathStr;
  56.   Header         : HeaderType;
  57.   BlockSize, FirstBlock,
  58.   FSize2, BlockNumber, BaseBlock, FSize1 : Word;
  59.   Errs, RealErrs : Byte;
  60.   StatMsg        : S80;
  61.   DidNAK         : Byte;
  62.   Buffer         : Pointer;
  63.   Sliding, DoChkSum, RecvACKLess : Boolean;
  64.   InFile         : FILE;
  65.  
  66.   PROCEDURE SendACK;
  67.   BEGIN
  68.     IF (NOT RecvACKLess) OR (BlockNumber=0) THEN
  69.     BEGIN
  70.       ComPort^.WriteByte(Ack, False);
  71.       IF Sliding THEN
  72.       BEGIN
  73.         ComPort^.WriteByte(Lo(BlockNumber), False);
  74.         ComPort^.WriteByte(Lo(NOT(BlockNumber)), False);
  75.       END;
  76.       ComPort^.FlushTx;
  77.       IF BlockNumber <= FSize1 THEN ShowCurrentByte(LongInt(BlockNumber) * LongInt(BlockSize),false);
  78.     END ELSE
  79.     BEGIN
  80.       IF (((NOT BlockNumber AND $1f)=0) AND (BlockNumber<FSize1)) OR (BlockNumber=FSize1) THEN
  81.         ShowCurrentByte(LongInt(BlockNumber) * LongInt(BlockSize),false);
  82.     END;
  83.     Errs:=0;
  84.   END;
  85.  
  86.   PROCEDURE SendNAK;
  87.   VAR
  88.     t1 : EventTimer;
  89.     i  : Integer;
  90.   BEGIN
  91.     Inc(Errs);
  92.     Inc(RealErrs);
  93.     IF Errs > 6 THEN
  94.     BEGIN
  95.       StatMsg:='FUBAR....';
  96.       Exit;
  97.     END;
  98.     Inc(DidNAK);
  99.     IF DidNAK > 8 THEN RecvACKLess:=False;
  100.     ComPort^.PurgeIn;
  101.     IF NOT RecvACKLess THEN
  102.     BEGIN
  103.       NewTimerSecs(t1, 30);
  104.       IF (BaseBlock <> BlockNumber) OR (Errs > 1) THEN
  105.       BEGIN
  106.         REPEAT
  107.           i:=TimedRead(100);
  108.           IF NOT ComPort^.Carrier THEN Exit;
  109.           IF TimerExpired(t1) THEN Break;
  110.         UNTIL i<0;
  111.       END;
  112.     END;
  113.     IF BlockNumber > BaseBlock THEN
  114.       ComPort^.WriteByte(Nak, True)
  115.     ELSE
  116.       IF (Errs<5) AND (not DoChkSum) THEN
  117.         ComPort^.WriteByte(Byte('C'), True)
  118.       ELSE
  119.       BEGIN
  120.         DoChkSum:=True;
  121.         ComPort^.WriteByte(Nak, True);
  122.       END;
  123.     IF Sliding THEN
  124.     BEGIN
  125.       ComPort^.WriteByte(Lo(BlockNumber), False);
  126.       ComPort^.WriteByte(Lo(NOT BlockNumber), True);
  127.     END;
  128.     IF BlockNumber <= FSize1 THEN ShowCurrentByte(LongInt(BlockNumber) * LongInt(BlockSize),false);
  129.   END;
  130.  
  131.   PROCEDURE GetBlock;
  132.   VAR
  133.     SPtr           : String;
  134.     Written, Crc   : Word;
  135.     chksum         : Byte;
  136.     BlockErr       : Byte;
  137.     IsResend       : Boolean;
  138.     msb, lsb, i, InChar : Integer;
  139.   BEGIN
  140.     BlockErr:=0; IsResend:=False;
  141.     InChar:=TimedRead(500);
  142.     IF InChar <> Lo(BlockNumber) THEN
  143.       IF InChar<Integer(BlockNumber) THEN IsResend:=True ELSE
  144.         IF (BlockNumber > 0) OR (InChar <> 1) THEN
  145.         BEGIN
  146.           Inc(BlockErr);
  147.           StatMsg:='Sync';
  148.         END ELSE BlockNumber:=1;
  149.     i:=TimedRead(500);
  150.     IF Lo(i) <> Lo(NOT InChar) THEN
  151.     BEGIN
  152.       Inc(BlockErr);
  153.       StatMsg:='Complement';
  154.     END;
  155.     FOR i:=0 TO BlockSize - 1 DO
  156.     BEGIN
  157.       InChar:=TimedRead(500);
  158.       IF InChar<0 THEN
  159.       BEGIN
  160.         IF ComPort^.Carrier THEN
  161.         BEGIN
  162.           SendNAK;
  163.           StatMsg:='Timeout';
  164.         END;
  165.         Exit;
  166.       END;
  167.       BT0(Buffer^)[i]:=Lo(InChar);
  168.     END;
  169.     IF DoChkSum THEN
  170.     BEGIN
  171.       ChkSum:=0;
  172.       FOR i:=0 TO BlockSize - 1 DO
  173.         Inc(chksum, BT0(Buffer^)[i]);
  174.       IF Lo(TimedRead(500)) <> chksum THEN
  175.       BEGIN
  176.         StatMsg:='ChkSum Error';
  177.         Inc(BlockErr);
  178.       END;
  179.     END ELSE
  180.     BEGIN
  181.       Crc:=0;
  182.       FOR i:=0 TO BlockSize - 1 DO
  183.         Crc:=UpdCrc16(BT0(Buffer^)[i], Crc);
  184.       Crc:=UpdCrc16(0, Crc);
  185.       Crc:=UpdCrc16(0, Crc);
  186.       msb:=TimedRead(300);
  187.       lsb:=TimedRead(300);
  188.       IF (lsb<0) OR (msb<0) THEN
  189.       BEGIN
  190.         StatMsg:='Short block';
  191.         IF BlockNumber=0 THEN Sliding:=False;
  192.         Inc(BlockErr);
  193.       END ELSE
  194.         IF (Lo(msb) SHL 8) + Lo(lsb) <> Crc THEN
  195.         BEGIN
  196.           StatMsg:='CRC Error';
  197.           Inc(BlockErr);
  198.         END;
  199.     END;
  200.     IF BlockErr > 0 THEN SendNAK ELSE
  201.     BEGIN
  202.       SendACK;
  203.       IF IsResend THEN Exit;
  204.       IF BlockNumber > 0 THEN
  205.       BEGIN
  206.         IF BlockNumber <= FSize1 THEN
  207.           BlockWrite(InFile, Buffer^, BlockSize, Written)
  208.         ELSE
  209.           BlockWrite(InFile, Buffer^, FSize2, Written);
  210.         IF FirstBlock > 0 THEN
  211.         BEGIN
  212.           { check nodelist }
  213.         END;
  214.       END ELSE
  215.       BEGIN
  216.         Move(Buffer^, Header, SizeOf(Header));
  217.         IF FirstBlock=0 THEN
  218.         BEGIN
  219.           SPtr:=Asciiz2Str(Header.FName, 17);
  220.           IF NetMail THEN SPtr:=InventPktName;
  221.           FOR i:=Length(SPtr) DOWNTO 1 DO
  222.             IF SPtr[i] <= ' ' THEN SPtr[0]:=Char(i - 1);
  223.           IF SPtr <> '' THEN
  224.           BEGIN
  225.             FinalName:=_FPath + SPtr;
  226.             SPtr:=FinalName;
  227.             i:=Length(FinalName);
  228.  {          IF NetMail THEN p:=CheckNetFile(Sptr) ELSE p:=Receiving;}
  229.             ShowCurrentFilename(SPtr,0,Header.FSize,90,false);
  230.           END ELSE
  231.             AddLog('!', 'Grunged hdr');
  232.         END;
  233.         IF Header.FSize <> 0 THEN
  234.         BEGIN
  235.           FSize1:=LongInt(Header.FSize DIV 128);
  236.           FSize2:=LongInt(Header.FSize MOD 128);
  237.         END;
  238.         IF Header.FTime <> 0 THEN FileSecs:=Header.FTime ELSE FileSecs:=- 1;
  239.         IF Asciiz2Str(Header.Moi, 15) <> '' THEN ShowError('From: '+Asciiz2Str(Header.Moi, 15),False,true,false);
  240.         IF (ComPort^.GetBaudRate >= 9600) AND (Header.NoACKs <> 0) AND (NOT NoOverdrive) THEN
  241.           RecvACKLess:=True;
  242.         ShowBlockSize(BlockSize,false);
  243.       END;
  244.       Inc(BlockNumber);
  245.     END;
  246.   END;
  247.  
  248.   FUNCTION ReceiveFile(CONST FPath, FName: PathStr; Protocol: ProtocolType) : Integer;
  249.   LABEL
  250.     Lost, LoopTop, FUBAR, Done;
  251.   VAR
  252.     TmpName        : PathStr;
  253.     k, MayBeSeadog : Boolean;
  254.     i, j           : Byte;
  255.     InChar         : Integer;
  256.     t1             : EventTimer;
  257.     Srec           : SEARCHREC;
  258.   BEGIN
  259.     DidNAK:=0; FileSecs:=- 1; Errs:=0; RealErrs:=0;
  260.     RecvACKLess:=False;
  261.     ComPort^.SetXOn(Off);
  262.     IF Protocol=_f THEN
  263.     BEGIN
  264.       MayBeSeadog:=True;
  265.       NetMail:=False;
  266.       Protocol:=SeaLink;
  267.       FirstBlock:=0;
  268.     END ELSE
  269.       IF Protocol=_b THEN
  270.       BEGIN
  271.         Protocol:=SeaLink;
  272.         NetMail:=True;
  273.         MayBeSeadog:=True;
  274.         FirstBlock:=1;
  275.       END ELSE
  276.       BEGIN
  277.         MayBeSeadog:=False;
  278.         NetMail:=False;
  279.         FirstBlock:=0;
  280.       END;
  281.     FSize1:=65535;
  282.     _FPath:=AddBackSlash(FPath);
  283. {    FOR InChar:=1 TO Length(FName) DO
  284.       IF FName[InChar] IN ['*', '?'] THEN FName:='';}
  285.     Sliding:=True;
  286.     BaseBlock:=0; DoChkSum:=False;
  287.     BlockSize:=128;
  288.     CASE Protocol OF
  289.       XModem : BEGIN
  290.                  BaseBlock:=1;
  291.                  Sliding:=False;
  292.                  ShowErrorCheckingMethod('XModem Receive',false);
  293.                END;
  294.       YModem : BEGIN
  295.                  BaseBlock:=1;
  296.                  Sliding:=False;
  297.                  BlockSize:=1024;
  298.                  ShowErrorCheckingMethod('YModem Receive',false);
  299.                END;
  300.       SeaLink: ShowErrorCheckingMethod('SeaLink Receive',false);
  301.       TeLink : ShowErrorCheckingMethod('TeLink Receive',false);
  302.       Modem7 : BEGIN
  303.                  BaseBlock:=1;
  304.                  Sliding:=False;
  305.                  ShowErrorCheckingMethod('Modem7 Receive',false);
  306.                END;
  307.     END;
  308.     ShowBlockSize(BlockSize,false);
  309.     BlockNumber:=BaseBlock;
  310.     TmpName:=_FPath + '_TMP_.$$$';
  311.     IF (Pos(FName, '*')=0) AND (Pos(FName, '?')=0) THEN FinalName:=_FPath+FName ELSE FinalName:=_FPath+'UNKNOWN.$$$';
  312.     Assign(InFile, TmpName);
  313.     Rewrite(InFile, 1);
  314.     IF IoResult <> 0 THEN
  315.     BEGIN
  316.       ShowError('Can''t open file',True,true,false);
  317.       ReceiveFile:=0;
  318.       Exit;
  319.     END;
  320.     {check for tty}
  321.     GetMem(Buffer, 1024);
  322.     StatMsg:='';
  323.     IF NOT MayBeSeadog THEN SendNAK;
  324.     NewTimerSecs(t1, 3);
  325.     RealErrs:=0;
  326. LoopTop:
  327.     IF GotESC THEN
  328.     BEGIN
  329.       StatMsg:='Keyboard Escape';
  330.       GOTO FUBAR;
  331.     END;
  332.     InChar:=TimedRead(400);
  333.     CASE Lo(InChar) OF
  334.       Soh : BEGIN
  335.               BlockSize:=128;
  336.               GetBlock;
  337.               NewTimerSecs(t1, 3);
  338.             END;
  339.       Stx : BEGIN
  340.               BlockSize:=1024;
  341.               GetBlock;
  342.               NewTimerSecs(t1, 3);
  343.             END;
  344.       Syn : BEGIN
  345.               DoChkSum:=True;
  346.               GetBlock;
  347.               DoChkSum:=False;
  348.               NewTimerSecs(t1, 3);
  349.             END;
  350.       Can : BEGIN
  351.               IF TimedRead(200)=Can THEN
  352.               BEGIN
  353.                 StatMsg:='Got CAN';
  354.                 GOTO FUBAR;
  355.               END;
  356.               NewTimerSecs(t1, 3);
  357.             END;
  358.       Eot : BEGIN
  359.               StatMsg:='End of transfer';
  360.               NewTimer(t1, 2);
  361.               WHILE NOT TimerExpired(t1) DO
  362.                 TimedRead(0);
  363.               IF BlockNumber > 0 THEN GOTO Done ELSE GOTO FUBAR;
  364.             END;
  365.     ELSE BEGIN
  366.         IF InChar > 0 THEN
  367.         BEGIN
  368.           IF NOT MayBeSeadog THEN ShowError('???',True,false,false);
  369.         END ELSE
  370.           IF NOT ComPort^.Carrier THEN GOTO Lost;
  371.         IF (TimerExpired(t1)) OR (NOT MayBeSeadog) THEN SendNAK;
  372.       END;
  373.     END;
  374.     IF Errs > 14 THEN
  375.     BEGIN
  376.       StatMsg:='FUBAR...';
  377.       GOTO FUBAR;
  378.     END;
  379.     IF StatMsg <> '' THEN
  380.     BEGIN
  381.       ShowError(StatMsg,True,false,false);
  382.       StatMsg:='';
  383.     END;
  384.     GOTO LoopTop;
  385. Lost:
  386.     StatMsg:='Carrier Lost';
  387. FUBAR:
  388.     Close(InFile);
  389.     DeleteFile(TmpName);
  390.     ComPort^.PurgeOut;
  391.     IF StatMsg <> 'End of transfer' THEN
  392.     BEGIN
  393.       FOR InChar:=0 TO 4 DO
  394.         ComPort^.WriteByte(Can, InChar=4);
  395.       AddLog('!', 'File not received ...');
  396.     END;
  397.     ComPort^.PurgeIn;
  398.     FreeMem(Buffer, 1024);
  399.     ReceiveFile:=0;
  400.     Exit;
  401. Done:
  402.     RecvACKLess:=False;
  403.     SendACK;
  404.     Close(InFile);
  405.     i:=Length(TmpName);
  406.     j:=Length(FinalName);
  407.     IF TmpName[i]='.' THEN Delete(TmpName, i, 1);
  408.     IF FinalName[j]='.' THEN
  409.     BEGIN
  410.       Delete(FinalName, j, 1);
  411.       Dec(j);
  412.     END;
  413.     i:=0;
  414.     k:=False;                   {IsArcMail(FinalName,j)}
  415.     IF (NOT OverWrite) OR (k) THEN
  416.     BEGIN
  417.       WHILE NOT RenameFile(TmpName, FinalName) DO
  418.       BEGIN
  419.         IF FinalName[j] IN ['0'..'9'] THEN FinalName[j]:=Char(Byte(FinalName[j]) + 1) ELSE
  420.           FinalName[j]:='0';
  421.         IF NOT(FinalName[j] IN ['0'..'9']) THEN
  422.         BEGIN
  423.           FinalName:=TmpName;
  424.           ReceiveFile:=1;
  425.           Exit;
  426.         END;
  427.         i:=1;
  428.       END;
  429.     END ELSE
  430.     BEGIN
  431.       DeleteFile(FinalName);
  432.       RenameFile(TmpName, FinalName);
  433.     END;
  434.     IF i <> 0 THEN AddLog('+', 'Dupe file renamed: ' + FinalName);
  435.     FINDFIRST(FinalName, AnyFile, Srec);
  436.     IF DOSERROR=0 THEN
  437.     BEGIN
  438.       IF FileSecs <> - 1 THEN
  439.       BEGIN
  440.         ASSIGN(InFile,FinalName); FileMode:=ShareRW+ShareDenyRW;
  441.         RESET(InFile);
  442.         SetFTime(InFile,FileSecs);
  443.         CLOSE(InFile);
  444.       END;
  445.       IF RealErrs > 4 THEN AddLog('+', 'Corrected %d errors in %d blocks');
  446.       AddLog('+', 'Received-S ' + FinalName);
  447.       FinalName:=Srec.Name;
  448.       ReceiveFile:=1;
  449.       FindClose(Srec);
  450.       Exit;
  451.     END;
  452.     FindClose(SRec);
  453.     FreeMem(Buffer, 1024);
  454.     ReceiveFile:=0;
  455.   END;
  456.  
  457.   {-=-=-=-=-=-=-}
  458.  
  459.   FUNCTION SendFile(CONST FName, Alias: PathStr; Protocol: ProtocolType) : Integer;
  460.   LABEL
  461.     Continue, FUBAR, SendLoop, SlideReply, Done, Reply, GoHome;
  462.   VAR
  463.     test, Errs     : Word;
  464.     Header         : HeaderType;
  465.     OutFile        : FILE;
  466.     BlockTimer     : EventTimer;
  467.     Message        : String;
  468.     Buffer         : Pointer;
  469.     Temp, LastBlock,
  470.     BlkNum,
  471.     ACKBlock       : LongInt;
  472.     Srec           : SEARCHREC;
  473.     AcklessOk, DoChkSum, Sliding, MayBeSeadog : Boolean;
  474.     WinSize, i, j, SendTmp,
  475.     InChar, InChar1, Base,
  476.     BlockSize,RealErrs,
  477.     FullWindow,
  478.     ACKErr         : Integer;
  479.     Head, chksum   : Byte;
  480.     Crc16 : Word;
  481.   BEGIN
  482.     IF Protocol=_f THEN
  483.     BEGIN
  484.       Protocol:=SeaLink;
  485.       MayBeSeadog:=True;
  486.     END ELSE
  487.       MayBeSeadog:=False;
  488.  
  489.     Sliding:=False; ACKBlock:=- 1; DoChkSum:=False; Errs:=0; ACKErr:=0; RealErrs:=0;
  490.     FullWindow:=ComPort^.GetBaudRate DIV 400;
  491.     IF (SmallWindow) AND (FullWindow > 6) THEN FullWindow:=6;
  492.     ComPort^.SetXOn(Off);
  493.     IF FName='' THEN
  494.     BEGIN
  495.       ComPort^.PurgeIn;
  496.       FOR i:=1 TO 4 DO
  497.       BEGIN
  498.         InChar:=TimedRead(700);
  499.         CASE InChar OF
  500.           67,
  501.           Nak,
  502.           Can : ComPort^.WriteByte(Eot, True);
  503.           TSync : BEGIN
  504.                     SendFile:=TSync;
  505.                     Exit;
  506.                   END;
  507.         ELSE IF InChar<32 THEN
  508.           BEGIN
  509.             SendFile:=0;
  510.             Exit;
  511.           END;
  512.         END;
  513.       END;
  514.       SendFile:=0;
  515.       Exit;
  516.     END;
  517. {   FName:=StLoCase(FName);}
  518.     FINDFIRST(FName, AnyFile, Srec);
  519.     IF DOSERROR <> 0 THEN
  520.     BEGIN
  521.       AddLog('!', FName + ' not found');
  522.       {SendCan;}
  523.       SendFile:=0;
  524.       FindClose(Srec);
  525.       Exit;
  526.     END;
  527.     FindClose(SRec);
  528.     { Check for TTY }
  529.     BlockSize:=128;
  530.     Head:=Soh;
  531.     Base:=1;
  532.     CASE Protocol OF
  533.       YModem : BEGIN
  534.                  BlockSize:=1024;
  535.                  Head:=Stx;
  536.                END;
  537.       SeaLink : Base:=0;
  538.       TeLink : BEGIN
  539.                  Base:=0;
  540.                  Head:=Syn;
  541.                END;
  542.     END;
  543.     GetMem(Buffer, BlockSize);
  544.     BlkNum:=Base;
  545.     LastBlock:=((Srec.size + (BlockSize - 1)) DIV BlockSize);
  546.     ShowCurrentFileName(JustFileName(FName),0,SRec.Size,90,false);
  547.     CASE Protocol OF
  548.       YModem : ShowErrorCheckingMethod('YModem Send',false);
  549.       XModem : ShowErrorCheckingMethod('XModem Send',false);
  550.       SeaLink : ShowErrorCheckingMethod('SeaLink Send',false);
  551.       TeLink : ShowErrorCheckingMethod('TeLink Send',false);
  552.       Modem7 : ShowErrorCheckingMethod('Modem7 Send',false);
  553.     END;
  554.     ShowBlockSize(BlockSize,false);
  555.     Assign(OutFile, FName); FileMode:=ShareRead+ShareDenyW;
  556.     Reset(OutFile, 1);
  557.     REPEAT
  558. Continue:
  559.       DoChkSum:=False;
  560.       i:=TimedRead(900);
  561.       CASE i OF
  562.         Nak,
  563.         67 : BEGIN
  564.                DoChkSum:=(i=Nak);
  565.                SendTmp:=TimedRead(400);
  566.                IF (SendTmp >= 0) AND (TimedRead(200)=(Not(Lo(SendTmp)))) THEN
  567.                  IF SendTmp <= 1 THEN Sliding:=True ELSE
  568.                  BEGIN
  569.                    ComPort^.WriteByte(Eot, True);
  570.                    GOTO Continue;
  571.                  END;
  572.                IF MayBeSeadog THEN Sliding:=True;
  573.                Errs:=0;
  574.                ComPort^.PurgeIn;
  575.                {start timer...}
  576.                GOTO SendLoop;
  577.              END;
  578.         Can : BEGIN
  579.                 Message:='Cancelled';
  580.                 GOTO FUBAR;
  581.               END;
  582.       ELSE BEGIN
  583.           IF GotESC THEN
  584.           BEGIN
  585.             Message:='Keyboard escape';
  586.             GOTO FUBAR;
  587.           END ELSE
  588.           BEGIN
  589.             Inc(Errs);
  590.             IF Errs > 15 THEN
  591.             BEGIN
  592.               Message:='Timeout';
  593.               GOTO FUBAR;
  594.             END;
  595.           END;
  596.           NewTimer(BlockTimer, 9);
  597.           WHILE NOT TimerExpired(BlockTimer) DO
  598.             ;
  599.           ComPort^.PurgeIn;
  600.         END;
  601.       END;
  602.     UNTIL NOT ComPort^.Carrier;
  603.     Message:='No carrier';
  604.     GOTO FUBAR;
  605.  
  606. SendLoop:
  607.     WHILE ComPort^.Carrier DO
  608.     BEGIN
  609.       Message:='';
  610.       IF BlkNum<2 THEN WinSize:=2 ELSE
  611.         IF SendACKLess THEN WinSize:=220 ELSE WinSize:=FullWindow;
  612.       IF GotESC THEN
  613.       BEGIN
  614.         Message:='Keyboard Escape';
  615.         GOTO FUBAR;
  616.       END;
  617.       IF BlkNum <= LastBlock THEN
  618.       BEGIN
  619.         IF BlkNum > 0 THEN
  620.         BEGIN
  621.           Seek(OutFile, (BlkNum - 1) * BlockSize);
  622.           IF IoResult <> 0 THEN
  623.           BEGIN
  624.             Message:='Seek error';
  625.             GOTO FUBAR;
  626.           END;
  627.           FillChar(Buffer^, BlockSize, 0);
  628.           BlockRead(OutFile, Buffer^, BlockSize, test);
  629.           ShowCurrentByte(FilePos(OutFile),false);
  630.           IF IoResult <> 0 THEN
  631.           BEGIN
  632.             Message:='Read error';
  633.             GOTO FUBAR;
  634.           END;
  635.         END ELSE
  636.         BEGIN
  637.           BlockSize:=128;
  638.           FillChar(Header, SizeOf(Header), 0);
  639.           Header.FSize:=Srec.size;
  640.           Header.FTime:=Srec.Time;
  641.           IF Alias='' THEN
  642.             Str2AsciiZ(JustFileName(StLoCase(FName)), Header.FName,17)
  643.           ELSE
  644.             Str2AsciiZ(JustFileName(Alias), Header.FName,17);
  645.           IF Protocol=TeLink THEN
  646.           BEGIN
  647.             FOR i:=0 TO 16 DO
  648.               IF Header.FName[i]=#0 THEN Header.FName[i]:=' ';
  649.             Header.FTime:=Srec.Time;
  650.           END;
  651.           Str2AsciiZ('Portal', Header.Moi,15);
  652.           IF (ComPort^.GetBaudRate >= 9600) AND (Sliding) AND (NOT NoOverdrive) THEN
  653.           BEGIN
  654.             Header.NoACKs:=1;
  655.             SendACKLess:=True;
  656.           END ELSE
  657.           BEGIN
  658.             Header.NoACKs:=0;
  659.             SendACKLess:=False;
  660.           END;
  661.           AcklessOk:=False;
  662.           FillChar(Buffer^,BlockSize,0);
  663.           Move(Header, Buffer^, SizeOf(Header));
  664.         END;
  665.         ComPort^.WriteByte(Head, False);
  666.         ComPort^.WriteByte(Lo(BlkNum), False);
  667.         ComPort^.WriteByte(NOT(Lo(BlkNum)), False);
  668.         FOR i:=0 TO BlockSize - 1 DO
  669.           ComPort^.WriteByte(BT0(Buffer^)[i], False);
  670.         IF (DoChkSum) OR (Head=Syn) THEN
  671.         BEGIN
  672.           chksum:=0;
  673.           FOR i:=0 TO BlockSize - 1 DO
  674.             Inc(chksum, BT0(Buffer^)[i]);
  675.           ComPort^.WriteByte(chksum, True);
  676.         END ELSE
  677.         BEGIN
  678.           Crc16:=0;
  679.           FOR i:=0 TO BlockSize - 1 DO
  680.             Crc16:=UpdCrc16(BT0(Buffer^)[i], Crc16);
  681.           Crc16:=UpdCrc16(0, Crc16);
  682.           Crc16:=UpdCrc16(0, Crc16);
  683.           ComPort^.WriteByte(Hi(Crc16), False);
  684.           ComPort^.WriteByte(Lo(Crc16), True);
  685.         END;
  686.       END;
  687.       NewTimerSecs(BlockTimer, 30);
  688. SlideReply:
  689.       IF NOT Sliding THEN
  690.       BEGIN
  691.         WHILE NOT ComPort^.OutEmpty DO
  692.           ;
  693.         NewTimerSecs(BlockTimer, 30);
  694.       END ELSE
  695.         IF ((BlkNum<(ACKBlock + WinSize)) AND (BlkNum<LastBlock) AND (NOT ComPort^.KeyPressed)) THEN
  696.         BEGIN
  697.           IF (SendACKLess) AND (BlkNum > 0) THEN
  698.           BEGIN
  699.             ACKBlock:=BlkNum;
  700.             IF BlkNum >= LastBlock THEN
  701.             BEGIN
  702.               IF AcklessOk THEN
  703.               BEGIN
  704.                 { write something??? }
  705.                 GOTO Done;
  706.               END;
  707.               BlkNum:=LastBlock + 1;
  708.               GOTO SendLoop;
  709.             END;
  710.             Inc(BlkNum);
  711.             IF (BlkNum AND $1f)=0 THEN
  712.             BEGIN
  713.               { update SLO display!!! }
  714.             END;
  715.           END ELSE
  716.             Inc(BlkNum);
  717.           GOTO SendLoop;
  718.         END;
  719.       IF NOT ComPort^.KeyPressed THEN
  720.       BEGIN
  721.         IF SendACKLess THEN
  722.         BEGIN
  723.           ACKBlock:=BlkNum;
  724.           IF BlkNum >= LastBlock THEN
  725.           BEGIN
  726.             IF AcklessOk THEN
  727.             BEGIN
  728.               { write something AGAIN!!! }
  729.               GOTO Done;
  730.             END;
  731.             BlkNum:=LastBlock + 1;
  732.             GOTO SendLoop;
  733.           END;
  734.           Inc(BlkNum);
  735.           IF (BlkNum MOD 32)=0 THEN
  736.           BEGIN
  737.             { write again.... }
  738.           END;
  739.           GOTO SendLoop;
  740.         END;
  741.       END;
  742.  
  743. Reply:
  744.       WHILE (NOT ComPort^.OutEmpty) AND (NOT ComPort^.KeyPressed) DO
  745.         ;
  746.       InChar:=TimedRead(3000);
  747.       IF InChar<0 THEN
  748.       BEGIN
  749.         Message:='Timeout';
  750.         GOTO FUBAR;
  751.       END;
  752.       IF InChar=67 THEN
  753.       BEGIN
  754.         DoChkSum:=False;
  755.         InChar:=Nak;
  756.       END;
  757.       IF InChar=Can THEN
  758.       BEGIN
  759.         Message:='Cancelled';
  760.         GOTO FUBAR;
  761.       END;
  762.       IF (InChar > 0) AND (Sliding) THEN
  763.       BEGIN
  764.         Inc(ACKErr);
  765.         IF ACKErr >= 10 THEN
  766.         BEGIN
  767.           IF SendACKLess THEN
  768.           BEGIN
  769.             SendACKLess:=False;
  770.             Message:='No acks??????';
  771.           END;
  772.         END;
  773.         IF (InChar=Ack) OR (InChar=Nak) THEN
  774.         BEGIN
  775.           i:=TimedRead(400);
  776.           IF i<0 THEN
  777.           BEGIN
  778.             Sliding:=False;
  779.             IF SendACKLess THEN
  780.             BEGIN
  781.               SendACKLess:=False;
  782.               Message:='No acks????';
  783.             END;
  784.           END ELSE
  785.           BEGIN
  786.             j:=TimedRead(200);
  787.             IF j<0 THEN
  788.             BEGIN
  789.               Sliding:=False;
  790.               IF SendACKLess THEN
  791.               BEGIN
  792.                 SendACKLess:=False;
  793.                 Message:='No Acks!?!?!?!';
  794.               END;
  795.             END ELSE
  796.             BEGIN
  797.               IF i=(j XOR $ff) THEN
  798.               BEGIN
  799.                 Temp:=BlkNum - (Lo(BlkNum - i));
  800.                 IF ((Temp <= BlkNum) AND (Temp > (BlkNum - WinSize - 10))) THEN
  801.                 BEGIN
  802.                   IF InChar=Ack THEN
  803.                   BEGIN
  804.                     IF ((Head=Syn) AND (BlkNum > 0)) THEN Head:=Soh;
  805.                     IF SendACKLess THEN
  806.                     BEGIN
  807.                       AcklessOk:=True;
  808.                       GOTO SlideReply;
  809.                     END ELSE
  810.                       ACKBlock:=Temp;
  811.                     Inc(BlkNum);
  812.                     IF ACKBlock >= LastBlock THEN GOTO Done;
  813.                     Errs:=0;
  814.                   END ELSE
  815.                   BEGIN
  816.                     BlkNum:=Temp;
  817.                     ComPort^.PurgeOut;
  818.                     Inc(Errs);
  819.                     Inc(RealErrs);
  820.                   END;
  821.                 END;
  822.               END ELSE
  823.               BEGIN
  824.                 Message:='Slide Cmpl Err';
  825.               END;
  826.             END;
  827.           END;
  828.         END ELSE
  829.         BEGIN
  830.           ShowError('Debris',True,false,false);
  831.           IF (TimerExpired(BlockTimer)) AND (ComPort^.OutEmpty) THEN
  832.           BEGIN
  833.             Message:='TimeOut';
  834.             GOTO FUBAR;
  835.           END ELSE
  836.             IF NOT ComPort^.OutEmpty THEN NewTimerSecs(BlockTimer, 30);
  837.           GOTO SlideReply;
  838.         END;
  839.       END;
  840.       IF NOT Sliding THEN
  841.       BEGIN
  842.         IF InChar=Ack THEN
  843.         BEGIN
  844.           IF BlkNum=10 THEN Pause(3);
  845.           IF ComPort^.KeyPressed THEN
  846.           BEGIN
  847.             SendTmp:=TimedRead(400);
  848.             IF (SendTmp >= 0) AND (TimedRead(200)=(NOT(Lo(SendTmp)))) THEN
  849.             BEGIN
  850.               Sliding:=True;
  851.               ACKBlock:=SendTmp;
  852.             END;
  853.           END;
  854.           Message:='';
  855.           IF BlkNum >= LastBlock THEN GOTO Done;
  856.           Inc(BlkNum);
  857.           IF (Head=Syn) AND (BlkNum > 0) THEN Head:=Soh;
  858.           Errs:=0;
  859.         END ELSE
  860.         BEGIN
  861.           IF InChar=Nak THEN
  862.           BEGIN
  863.             Inc(Errs);
  864.             Inc(RealErrs);
  865.             Pause(5);
  866.             ComPort^.PurgeOut;
  867.             Message:='Nak';
  868.           END ELSE
  869.           BEGIN
  870.             IF ComPort^.Carrier THEN
  871.             BEGIN
  872.               IF NOT TimerExpired(BlockTimer) THEN
  873.                 GOTO Reply
  874.               ELSE
  875.               BEGIN
  876.                 Message:='TimeOut';
  877.                 GOTO FUBAR;
  878.               END;
  879.             END ELSE
  880.             BEGIN
  881.               Message:='No Carrier';
  882.               GOTO FUBAR;
  883.             END;
  884.           END;
  885.           IF Errs > 10 THEN
  886.           BEGIN
  887.             Message:='FuBar';
  888.             GOTO FUBAR;
  889.           END;
  890.           IF BlkNum <= LastBlock THEN Temp:=BlkNum ELSE Temp:=LastBlock;
  891.           { write again}
  892.           IF (Sliding) AND (ACKBlock > 0) THEN
  893.           BEGIN
  894.             IF SendACKLess THEN
  895.             BEGIN
  896.               {write *}
  897.             END ELSE
  898.             BEGIN
  899.               {write :}
  900.             END;
  901.           END;
  902.           IF Message <> '' THEN ShowError(Message,True,false,false);
  903.         END;
  904.       END;
  905.     END;                          {while}
  906.     Message:='No carrier';
  907. FUBAR:
  908.     ComPort^.PurgeOut;
  909.     {sendcan}
  910.     AddLog('!', 'File NOT send');
  911.     Close(OutFile);
  912.     FreeMem(Buffer, BlockSize);
  913.     SendFile:=0;
  914.     Exit;
  915. Done:
  916.     WHILE NOT ComPort^.OutEmpty DO ;
  917.     ComPort^.PurgeIn;
  918.     ComPort^.WriteByte(Eot, True);
  919.     ACKErr:=1;
  920.     BlkNum:=LastBlock + 1;
  921.     FOR i:=0 TO 4 DO
  922.     BEGIN
  923.       IF NOT ComPort^.Carrier THEN
  924.       BEGIN
  925.         ACKErr:=1;
  926.         GOTO GoHome;
  927.       END;
  928.       CASE TimedRead(500) OF
  929.         67,
  930.         Nak,
  931.         Can : BEGIN
  932.                 InChar:=TimedRead(400);
  933.                 IF (Sliding) AND (InChar >= 0) THEN
  934.                 BEGIN
  935.                   InChar1:=TimedRead(200);
  936.                   IF InChar=(InChar1 XOR $ff) THEN
  937.                   BEGIN
  938.                     BlkNum:=BlkNum - (Lo(BlkNum - InChar));
  939.                     ComPort^.PurgeIn;
  940.                     IF BlkNum <= LastBlock THEN GOTO SendLoop;
  941.                   END;
  942.                 END;
  943.                 ComPort^.PurgeIn;
  944.                 ComPort^.WriteByte(Eot, True);
  945.               END;
  946.         TSync : BEGIN
  947.                   ACKErr:=TSync;
  948.                   GOTO GoHome;
  949.                 END;
  950.         Ack : BEGIN
  951.                 InChar:=TimedRead(400);
  952.                 IF (Sliding) AND (InChar >= 0) THEN
  953.                 BEGIN
  954.                   InChar1:=TimedRead(200);
  955.                 END;
  956.                 ACKErr:=1;
  957.                 GOTO GoHome;
  958.               END;
  959.       END;
  960.     END;
  961. GoHome:
  962.     Close(OutFile);
  963.     FileSent(JustFileName(FName),'S',FALSE);
  964.     FreeMem(Buffer, BlockSize);
  965.     SendFile:=ACKErr;
  966.   END;
  967.  
  968.  
  969. END.
  970.